FileSys.f90

basic file and directory management
Source Code

!! basic file and directory management
!|author:  <a href="mailto:giovanni.ravazzani@polimi.it">Giovanni Ravazzani</a>
! license: <a href="http://www.gnu.org/licenses/">GPL</a>
!    
!### History
!
! current 1.2 - 4th September 2024
!
! | version  |  date       |  comment |
! |----------|-------------|----------|
! | 1.0      | 14/Feb/2013 | Original code |
! | 1.1      | 11/Feb/2021 | FileDir for returning list of files in a directory |
! | 1.2      | 04/Sep/2024 | FileSyncToLastLine for synchronizing to the last line of formatted file |
!    
!
!### License  
! license: GNU GPL <http://www.gnu.org/licenses/>
!
! This file is part of 
!
!   MOSAICO -- MOdular library for raSter bAsed hydrologIcal appliCatiOn.
! 
!   Copyright (C) 2011 Giovanni Ravazzani
!
!### Module Description 
!   This module is designed to provide basic file and directory management
!   and system operations for Windows and Linux based operating systems.
!   For setting operating system, code pre processing (FPP) is used
MODULE FileSys        
			

! 
! Modules used: 
! 
USE DataTypeSizes, ONLY : &
! Imported Type Definitions:
short, float, double 

USE LogLib, ONLY : &
! imported routines:
Catch    

USE Utilities, ONLY : &
! imported routines:
GetUnit

USE iso_varying_string, ONLY : &
!Imported definitions:
varying_string, &
!Imported routines:
Get, Put_line

IMPLICIT NONE 
! Global (i.e. public) Declarations: 

INTEGER, PARAMETER :: WIN32 = 1, UNIX = 2
         
! Global Routines:

PUBLIC :: FileExists
PUBLIC :: DirExists
PUBLIC :: FileDelete
PUBLIC :: DirDelete
PUBLIC :: FileNew
PUBLIC :: DirNew
PUBLIC :: KeepLines
PUBLIC :: FileRename
PUBLIC :: DirRename
PUBLIC :: CurrentDir
PUBLIC :: GetOS
PUBLIC :: DirList


! Local (i.e. private) Declarations:
! Local Procedures:


! Operator definitions:
! Define new operators or overload existing ones.


        
!=======
CONTAINS
!=======
! Define procedures contained in this module. 
    
    
    
!==============================================================================
!| Description:
!   return a list of files in a directory
SUBROUTINE DirList &
!
(dir, list, nfiles, filext)

IMPLICIT NONE

!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: dir 

!Optional arguments with intent(in):
CHARACTER (LEN = *), OPTIONAL, INTENT(IN) :: filext 

!Arguments with intent (out):
CHARACTER (LEN = *), INTENT(OUT) :: list
INTEGER (KIND = short), INTENT (OUT) :: nfiles


! Local declarations:  
CHARACTER (LEN = 1000)      :: cmd
INTEGER (KIND = short)      :: unit, i, ios
CHARACTER (LEN  = 300)      :: string
!------------end of declaration------------------------------------------------

IF (PRESENT (filext)) THEN !filter files for file extension
    IF (GetOS () == WIN32) THEN !detected Windows OS
       cmd = 'dir ' // TRIM(dir) // '*.' // TRIM(filext) // ' /b/a:-d > ' &
                    // TRIM (dir) // 'list.txt'
       CALL System (cmd)
    ELSE !detected unix like OS, including linux
      !cmd = 'ls *.' // TRIM(filext) // ' '  // TRIM(dir) // ' > ' // TRIM (dir) // 'list.txt'
      cmd = 'find ' // TRIM(dir) // ' -name "*.' // TRIM(filext) // &
            '" -printf "%f\n" > ' // TRIM (dir) // 'list.txt'
      CALL System (cmd)
    END IF
ELSE
    
    IF (GetOS () == WIN32) THEN !detected Windows OS
       cmd = 'dir ' // TRIM(dir) // ' /b/a:-d > ' // TRIM (dir) // 'list.txt'
       CALL System (cmd)
    ELSE !detected unix like OS, including linux
      cmd = 'ls *.?*' // dir // ' > ' // TRIM (dir) // 'list.txt'
      cmd = 'find ' // TRIM(dir) // ' -name "*.?*' // '" -printf "%f\n" > ' &
                    // TRIM (dir) // 'list.txt'
      CALL System (cmd)
    END IF
END IF

unit = GetUnit ()
OPEN (unit = unit, file = TRIM (dir) // 'list.txt')


list = ''
nfiles = 0
DO
   READ(unit,*,IOSTAT = ios) string
   IF (ios < 0)  THEN !end of file reached
       EXIT
   ELSE 
       nfiles = nfiles + 1
       IF (nfiles == 1) THEN
          list(1:) =  TRIM (string)
       ELSE
          list(LEN_TRIM (list)+1:) =  ',' // TRIM (string)
       END IF
   END IF
END DO


CLOSE (unit)


END SUBROUTINE DirList

!==============================================================================
!| Description:
!   returns `TRUE` if file exists
FUNCTION FileExists &
!
(file) &
!
RESULT (exists)

IMPLICIT NONE

!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: file 

! Local declarations:  
LOGICAL                    :: exists
!------------end of declaration------------------------------------------------

 INQUIRE(FILE = file, EXIST = exists)
  
 RETURN
END	FUNCTION FileExists


!==============================================================================
!| Description:
!   returns TRUE if directory exists
FUNCTION DirExists &
!
(dir) &
!
RESULT (exists)

IMPLICIT NONE

!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: dir 

! Local declarations:  
LOGICAL                    :: exists
!------------end of declaration------------------------------------------------

!work around for cross compiler portability
#ifdef __INTEL_COMPILER
    !DIRECTORY specification is available only in intel compiler
    INQUIRE(DIRECTORY = dir, EXIST = exists)
#else
    !this solution does not work for intel compiler
    INQUIRE(FILE = dir // '/.', EXIST = exists)
#endif

RETURN
END	FUNCTION DirExists

!==============================================================================
!| Description:
!   delete a file
SUBROUTINE FileDelete &
!
(file)

IMPLICIT NONE

!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: file 

! Local declarations:  
CHARACTER (LEN = 100)      :: cmd
!------------end of declaration------------------------------------------------

IF (GetOS () == WIN32) THEN !detected Windows OS
    cmd = 'del ' // file
    CALL System (cmd)
ELSE !detected unix like OS, including linux
    cmd = 'rm ' // file
    CALL System (cmd)
END IF

END SUBROUTINE FileDelete


!==============================================================================
!| Description:
!   delete a directory
SUBROUTINE DirDelete &
!
(dir)

IMPLICIT NONE

!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: dir 

! Local declarations:  
CHARACTER (LEN = 100)      :: cmd
!------------end of declaration------------------------------------------------

IF (GetOS () == WIN32) THEN !detected Windows OS
    cmd = 'rmdir ' // dir
    CALL System (cmd)
ELSE !detected unix like OS, including linux
    cmd = 'rm -R ' // dir
    CALL System (cmd)
END IF


END SUBROUTINE DirDelete


!==============================================================================
!| Description:
!   create a new text file
SUBROUTINE FileNew &
!
(file)

IMPLICIT NONE

!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: file 

! Local declarations:  
CHARACTER (LEN = 100)      :: cmd
!------------end of declaration------------------------------------------------

IF (.NOT. FileExists (file) ) THEN
   
IF (GetOS () == WIN32) THEN!detected Windows OS
    cmd = 'CD.>' // file
    CALL System (cmd)
ELSE !detected unix like OS, including linux
    cmd = 'touch ' // file
    CALL System (cmd)
END IF

END IF

END SUBROUTINE FileNew


!==============================================================================
!| Description:
!   create a new directory
SUBROUTINE DirNew &
!
(dir)

IMPLICIT NONE

!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: dir 

! Local declarations:  
CHARACTER (LEN = 100)      :: cmd
!------------end of declaration------------------------------------------------

   
IF (GetOS () == WIN32) THEN !detected Windows OS
    ! ./ not allowed
    cmd = 'mkdir ' // dir
    CALL System (cmd)
ELSE !detected unix like OS, including linux
    cmd = 'mkdir ' // dir
    CALL System (cmd)
END IF



END SUBROUTINE DirNew


!==============================================================================
!| Description:
!   Erase lines except the number specified as argument. pos defines wheter 
!   kept lines are counted starting from the beginning or from 
!   the end of file. Optional argument header defines number of lines
!   at the beginning of the file to be considered as header. Header lines 
!   are never deleted. Manipulated file is supposed to be already opened.
SUBROUTINE KeepLines &
!
(fileUnit, lines, pos, header)

IMPLICIT NONE

!Arguments with intent(in):
INTEGER (KIND = short), INTENT(IN) :: fileUnit
INTEGER (KIND = short), INTENT(IN) :: lines
CHARACTER (LEN = *), INTENT(IN) :: pos !!possible value: first, last
INTEGER (KIND = short), OPTIONAL, INTENT(IN) :: header 

! Local declarations:  
TYPE (varying_string), ALLOCATABLE :: headerBuffer (:)
TYPE (varying_string), ALLOCATABLE :: linesBuffer (:)
INTEGER (KIND = short) :: i
INTEGER (KIND = short) :: ios
INTEGER (KIND = short) :: countLines
CHARACTER (LEN = 1) :: junk
CHARACTER (LEN = 300) :: fileName
!------------end of declaration------------------------------------------------

IF (PRESENT (header)) THEN
  ALLOCATE (headerBuffer (header))
END IF

ALLOCATE (linesBuffer (lines))

!rewind file before counting lines
REWIND (fileUnit)

!count number of lines in the file
countLines = 0
DO 
  READ(fileUnit,*,IOSTAT=ios) junk
  countLines = countLines + 1
  IF (ios /= 0) EXIT
END DO

IF (PRESENT (header)) THEN
  IF (countLines < lines + header) THEN
     INQUIRE (UNIT=fileUnit, NAME=fileName)
     CALL Catch ('info', 'FileSys',  &
       'current number of lines less than maximum in file: ', &
       argument = TRIM(fileName)  )
     RETURN
  END IF
ELSE
  IF (countLines < lines) THEN
     INQUIRE (UNIT=fileUnit, NAME=fileName)
     CALL Catch ('info', 'FileSys',  &
       'current number of lines less than maximum in file: ', &
       argument = TRIM(fileName)  )
     RETURN
  END IF
END IF

!rewind file before reading
REWIND (fileUnit)

IF (PRESENT(header)) THEN
    countLines = countLines - header
    DO i =1, header
      CALL Get (unit = fileUnit, string = headerBuffer(i))
    END DO
END IF

IF (pos == 'first') THEN
    DO i =1, lines
      CALL Get (unit = fileUnit, string = linesBuffer(i))
    END DO
ELSE
    DO i = 1, countLines - lines
        READ(fileUnit,*) junk
    END DO
    
     DO i =1, lines
      CALL Get (unit = fileUnit, string = linesBuffer(i))
    END DO
    
END IF


!rewind file before writing
REWIND (fileUnit)

!overwrite file
IF (PRESENT(header)) THEN
   DO i =1, header
      CALL Put_line (unit = fileUnit, string = headerBuffer(i))
    END DO
END IF

DO i =1, lines
   CALL Put_line (unit = fileUnit, string = linesBuffer(i))
END DO




!release memory
DEALLOCATE (headerBuffer)
DEALLOCATE (linesBuffer)


END SUBROUTINE KeepLines
   


!==============================================================================
!| Description:
!   rename a file. If renamed file already exists it is not overwritten
!   and warning is raised.
SUBROUTINE FileRename &
!
(file,file2)

IMPLICIT NONE

!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: file
CHARACTER (LEN = *), INTENT(IN) :: file2

! Local declarations:  
CHARACTER (LEN = 100)      :: cmd
!------------end of declaration------------------------------------------------

IF (FileExists (file2)) THEN
  CALL Catch ('warning', 'FileSys',  &
       'trying to rename an existing file: ', &
       argument = file2  )
  RETURN
END IF

IF (GetOS () == WIN32) THEN !detected Windows OS
    cmd = 'rename ' // file // ' ' // file2
    CALL System (cmd)
ELSE !detected unix like OS, including linux
    cmd = 'mv ' // file // ' ' // file2
    CALL System (cmd)
END IF



END SUBROUTINE FileRename

!==============================================================================
!| Description:
!   rename a directory
SUBROUTINE DirRename &
!
(dir,dir2)

IMPLICIT NONE

!Arguments with intent(in):
CHARACTER (LEN = *), INTENT(IN) :: dir
CHARACTER (LEN = *), INTENT(IN) :: dir2

! Local declarations:  
CHARACTER (LEN = 100)      :: cmd
!------------end of declaration------------------------------------------------

IF (DirExists (dir2)) THEN
  CALL Catch ('warning', 'FileSys',  &
       'trying to rename an existing directory: ', &
       argument = dir2  )
  RETURN
END IF


IF (GetOS () == WIN32) THEN !detected Windows OS
    cmd = 'rename ' // dir // ' ' // dir2
    CALL System (cmd)
ELSE !detected unix like OS, including linux
    cmd = 'mv ' // dir // ' ' // dir2
    CALL System (cmd)
END IF



END SUBROUTINE DirRename


!==============================================================================
!| Description:
!   return current directory
FUNCTION CurrentDir &
!
( ) &
!
RESULT (cwd)

USE ifport

IMPLICIT NONE

! Local declarations:  
CHARACTER (LEN = 1000) :: cwd
INTEGER  :: istat
!------------end of declaration------------------------------------------------


  istat = getcwd(cwd)

RETURN
END FUNCTION CurrentDir

!==============================================================================
!| Description:
!   get operating system
FUNCTION GetOS &
!
( ) &
!
RESULT (os)

IMPLICIT NONE

! Local declarations:  
INTEGER  :: os
!------------end of declaration------------------------------------------------

#ifdef _WIN32 !detected Windows OS
    os = WIN32
#else !detected unix like OS, including linux
    os = UNIX
#endif

RETURN
END FUNCTION GetOS

!==============================================================================
!| Description:
!   synchronize to the last line of formatted file
SUBROUTINE FileSyncToLastLine &
!
(fileUnit, blanks)

IMPLICIT NONE

!Arguments with intent(in):
INTEGER (KIND = short), INTENT(IN) :: fileUnit !!unit of file to sync
INTEGER (KIND = short), INTENT(IN) :: blanks !!number of blank lines to add

! Local declarations:  
INTEGER (KIND = short) :: ios
INTEGER (KIND = short) :: i
!------------end of declaration------------------------------------------------

!rewind file before starting
REWIND (fileUnit)

!read till the end of file
DO 
  READ ( fileUnit, *, IOSTAT = ios ) 
  IF (ios /= 0) EXIT
END DO

!add blanck lines
DO i = 1, blanks
  WRITE ( fileUnit, *)
END DO

RETURN
END SUBROUTINE FileSyncToLastLine


END MODULE FileSys
FileSys.f90 Source File

Contents

Modules

Source Code

Source Code
